home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE13 / IDAPI / RECLABEL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-12  |  3.5 KB  |  134 lines
  1. unit Reclabel;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, DB, DBTables, Menus;
  8.  
  9. const StateStr: array[TDataSetState] of string[10] =
  10.         ('Closed', 'Browsing', 'Editing', 'Inserting', 'SetKey', 'CalcFields');
  11.  
  12. type
  13.   TRecDisplayType = (rdRecordNo, rdRecordNoOfCount);
  14.  
  15.   TDBRecLabel = class(TCustomLabel)
  16.   private
  17.     { Private declarations }
  18.     FDataLink: TFieldDataLink;
  19.     FDispType: TRecDisplayType;
  20.     procedure DoDataChange(Sender: TObject);
  21.     procedure DoActiveChange(Sender: TObject);
  22.     procedure SetDataSource(const Value: TDataSource);
  23.     procedure SetDispType(Value: TRecDisplayType);
  24.     function GetDataSource: TDataSource;
  25.   protected
  26.     { Protected declarations }
  27.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  28.   public
  29.     { Public declarations }
  30.     constructor Create(AOwner: TComponent); override;
  31.     destructor Destroy; override;
  32.   published
  33.     { Published declarations }
  34.     property DisplayType: TRecDisplayType read FDispType write SetDispType default rdRecordNo;
  35.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  36.     property Align;
  37.     property Alignment;
  38.     property AutoSize;
  39.     property Color;
  40.     property Enabled;
  41.     property Font;
  42.     property ParentColor;
  43.     property ParentFont;
  44.     property ParentShowHint;
  45.     property PopupMenu;
  46.     property ShowHint;
  47.     property Transparent;
  48.     property Visible;
  49.     property WordWrap;
  50.   end;
  51.  
  52. procedure Register;
  53.  
  54. implementation
  55.  
  56. uses DbiTypes, DbiProcs;
  57.  
  58. constructor TDBRecLabel.Create(AOwner: TComponent);
  59. begin
  60.   inherited Create(AOwner);
  61.   FDataLink := TFieldDataLink.Create;
  62.   FDataLink.OnDataChange := DoDataChange;
  63.   FDataLink.OnActiveChange := DoActiveChange;
  64.   FDispType := rdRecordNo;
  65. end;
  66.  
  67. destructor TDBRecLabel.Destroy;
  68. begin
  69.   FDataLink.OnDataChange := nil;
  70.   FDataLink.OnActiveChange := nil;
  71.   FDataLink.Free;
  72.   inherited Destroy;
  73. end;
  74.  
  75. procedure TDBRecLabel.Notification(AComponent: TComponent; Operation: TOperation);
  76. begin
  77.   inherited Notification(AComponent, Operation);
  78.   if (Operation = opRemove) and (AComponent = DataSource) then
  79.     FDataLink.DataSource := nil;
  80. end;
  81.  
  82. procedure TDBRecLabel.DoActiveChange(Sender: TObject);
  83. begin
  84.   if (DataSource <> nil) then
  85.   begin
  86.     Caption := StateStr[DataSource.State];
  87.     if DataSource.State = dsBrowse then DoDataChange(Self);
  88.   end
  89.   else
  90.     if csDesigning in ComponentState then
  91.       Caption := Self.Name
  92.     else
  93.       Caption := '';
  94. end;
  95.  
  96. procedure TDBRecLabel.DoDataChange(Sender: TObject);
  97. var RecNo: LongInt;
  98. begin
  99.   if FDataLink.DataSource.State = dsBrowse then
  100.   with FDataLink.DataSource.DataSet do
  101.   begin
  102.     UpdateCursorPos;
  103.     Check(DbiGetSeqNo(Handle, RecNo));
  104.     case FDispType of
  105.       rdRecordNo: Caption := format('Record %d', [RecNo]);
  106.       rdRecordNoOfCount: Caption := format('Record %d of %d', [RecNo, RecordCount]);
  107.     end
  108.   end
  109.   else
  110.     Caption := StateStr[FDataLink.DataSource.State];
  111. end;
  112.  
  113. procedure TDBRecLabel.SetDataSource(const Value: TDataSource);
  114. begin
  115.   FDataLink.DataSource := Value;
  116. end;
  117.  
  118. function TDBRecLabel.GetDataSource: TDataSource;
  119. begin
  120.   Result := FDataLink.DataSource;
  121. end;
  122.  
  123. procedure TDBRecLabel.SetDispType(Value: TRecDisplayType);
  124. begin
  125.   FDispType := Value;
  126. end;
  127.  
  128. procedure Register;
  129. begin
  130.   RegisterComponents('JOC', [TDBRecLabel]);
  131. end;
  132.  
  133. end.
  134.